home *** CD-ROM | disk | FTP | other *** search
/ Super Shareware Collection / Super Shareware Collection.iso / os_2 / clisp.zip / MACROS2.FAS < prev    next >
Text File  |  1994-02-05  |  11KB  |  184 lines
  1. (SYSTEM::VERSION '(SYSTEM::CLISP2 12. LISP:NIL 290893.))
  2. #Y(#:TOP-LEVEL-FORM-1 #13Y(00 00 00 00 00 01 D5 37 02 30 DE 19 01) "SYSTEM")
  3. #Y(#:TOP-LEVEL-FORM-2 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01) TYPECASE
  4.    REMOVE-OLD-DEFINITIONS MACRO
  5.    #Y(TYPECASE
  6.       #119Y(01 00 01 00 00 08 A9 6E 41 D5 8C 01 2D 0F 9A 57 74 9B 57 75 37 01 6E 82 5F A9 1A 80 45
  7.             A9 2E 01 19 03 D7 D8 90 02 5E 02 A7 C4 55 16 01 1C 1E 60 99 56 57 1B 01 C5 76 80 01 16
  8.             01 1A 2A 98 56 1F 61 98 56 74 A7 02 55 1C 5F 16 01 1B 62 DB AA DC 9B 56 74 77 02 77 03
  9.             99 56 57 1B 01 C8 76 80 01 7F 00 98 20 58 16 01 DE A9 AC 77 02 77 01 DF AA 31 43 76 5C
  10.             03 19 07
  11.            )
  12.       2. MACRO-CALL-ERROR "Invalid clause in ~S: ~S" TYPECASE OTHERWISE (NIL) TYPEP QUOTE (NIL) LET
  13.       COND
  14.   )  )
  15. #Y(#:TOP-LEVEL-FORM-3 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01) CHECK-TYPE
  16.    REMOVE-OLD-DEFINITIONS MACRO
  17.    #Y(CHECK-TYPE
  18.       #108Y(01 00 01 00 00 08 D5 AA 6E 41 D6 8D 02 2F 80 4F 9A 57 74 9B 57 57 74 9C 57 57 57 1B 80
  19.             46 00 14 37 01 6E 82 37 01 6E 82 D8 A9 D9 DA AF DB B0 77 02 77 03 DC AC 77 02 77 03 DD
  20.             DE DF 5F E0 B3 B2 B4 6A 05 0C B2 77 05 E2 5F E3 B2 6A 03 0C CF 78 02 E5 B1 D1 78 02 DC
  21.             AF 77 02 AE 5C 08 19 08 A9 2E 02 19 03 9C 57 57 57 56 1A FF B3
  22.            )
  23.       3. 4. MACRO-CALL-ERROR TAGBODY WHEN TYPEP QUOTE GO CERROR "You may input a new value."
  24.       "~A~%The value is: ~S" "The value of ~S should be ~:[of type ~S~;~:*~A~]." FORMAT
  25.       WRITE-STRING "~%New ~S: " (*QUERY-IO*) SETF ((READ *QUERY-IO*))
  26.   )  )
  27. #Y(#:TOP-LEVEL-FORM-4 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01) ASSERT
  28.    REMOVE-OLD-DEFINITIONS MACRO
  29.    #Y(ASSERT
  30.       #176Y(01 00 01 00 00 08 A9 6E 41 D5 8C 01 2D 80 52 9A 57 74 9B 57 57 1B 80 4E 00 14 9C 57 57
  31.             57 1B 80 4C 00 14 9D 57 57 57 75 37 01 6E 82 37 01 6E 82 D7 A9 D8 AF D9 AC 77 02 77 03
  32.             DA AF 6E 41 A7 23 06 33 A7 23 08 32 CA F6 E0 8E 09 01 CC 14 77 02 8E 09 28 5F E2 B4 6A
  33.             03 0E 5C 01 78 03 5F B0 1A 38 A9 2E 01 19 03 9B 57 57 56 1A FF AC 9C 57 57 57 56 1A FF
  34.             AD C7 1A 4F C9 1A 4C A0 1A 5D 90 00 E4 5F E5 AA 6A 03 0E D1 78 02 E7 A9 D3 78 02 77 02
  35.             AA 7C A2 02 16 01 7F 00 98 20 62 16 01 A7 7C A3 00 D9 AE 77 02 AD 77 02 32 02 20 5D 04
  36.             19 09
  37.            )
  38.       2. MACRO-CALL-ERROR TAGBODY WHEN GO CERROR 0. "Retry" 1. "You may input a new value."
  39.       "You may input new values." QUOTE "~A" "~S must evaluate to a non-NIL value." FORMAT
  40.       WRITE-STRING "~%New ~S: " (*QUERY-IO*) SETF ((READ *QUERY-IO*))
  41.   )  )
  42. #Y(#:TOP-LEVEL-FORM-5
  43.    #45Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 D9 2E 01 D9 D7 C5 76 31 74 DB 2E 01 DB D7 C7
  44.         76 31 74 DD 2E 01 DD D7 C9 76 31 74 C8 19 01
  45.        )
  46.    ETYPECASE REMOVE-OLD-DEFINITIONS MACRO
  47.    #Y(ETYPECASE
  48.       #36Y(01 00 01 00 00 08 A9 6E 41 D5 8C 01 2D 11 9A 57 74 9B 57 75 D7 A9 A9 AB AB C3 70 C4 33
  49.            19 05 A9 2E 01 19 03
  50.           )
  51.       2. MACRO-CALL-ERROR TYPECASE
  52.       #1=#Y(TYPECASE-ERRORSTRING #19Y(02 00 00 00 00 03 5F D5 AB D6 AC 6F 00 17 2C 04 02 19 03)
  53.             "The value of ~S must be of one of the types ~{~S~^, ~}" #.#'FIRST FORMAT
  54.            )
  55.       #2=#Y(SIMPLE-ERROR
  56.             #40Y(04 00 00 00 00 05 37 01 6E 82 D5 A8 AD 77 02 77 01 AE AA AE D6 D7 D8 B1 B0 77 04
  57.                  77 02 77 01 32 02 20 78 02 5C 03 19 06
  58.                 )
  59.             LET OTHERWISE ERROR "~A~%The value is: ~S"
  60.      )     )
  61.    CTYPECASE
  62.    #Y(CTYPECASE
  63.       #36Y(01 00 01 00 00 08 A9 6E 41 D5 8C 01 2D 11 9A 57 74 9B 57 75 D7 A9 A9 AB AB C3 70 C4 33
  64.            19 05 A9 2E 01 19 03
  65.           )
  66.       2. MACRO-CALL-ERROR TYPECASE #1#
  67.       #3=#Y(RETRY-LOOP
  68.             #67Y(04 00 00 00 00 05 37 01 6E 82 37 01 6E 82 D5 A9 D6 AA D7 AD B3 B3 B3 D8 D9 DA DB
  69.                  B7 BA 77 05 DC 5F DD BA 6A 03 09 CA 78 02 E0 B9 CC 78 02 E2 B5 77 02 77 05 77 01
  70.                  32 02 20 78 02 77 03 77 03 5C 03 19 07
  71.                 )
  72.             BLOCK TAGBODY RETURN-FROM OTHERWISE CERROR "You may input a new value."
  73.             "~A~%The value is: ~S" WRITE-STRING "~%New ~S: " FORMAT (*QUERY-IO*) SETF
  74.             ((READ *QUERY-IO*)) GO
  75.      )     )
  76.    ECASE
  77.    #Y(ECASE
  78.       #36Y(01 00 01 00 00 08 A9 6E 41 D5 8C 01 2D 11 9A 57 74 9B 57 75 D7 A9 A9 AB AB C3 70 C4 33
  79.            19 05 A9 2E 01 19 03
  80.           )
  81.       2. MACRO-CALL-ERROR CASE
  82.       #4=#Y(CASE-ERRORSTRING
  83.             #52Y(02 00 00 00 00 03 5F D5 AB 5F AC 1A 19 98 1A 0D 90 00 A7 83 00 00 14 8A 08 73 A7
  84.                  5C 01 F6 AA 7C A1 02 16 01 7F 00 98 20 67 16 01 A7 7C A3 00 2C 04 01 19 03
  85.                 )
  86.             "The value of ~S must be one of ~{~S~^, ~}" FORMAT
  87.            )
  88.       #2#
  89.      )
  90.    CCASE
  91.    #Y(CCASE
  92.       #36Y(01 00 01 00 00 08 A9 6E 41 D5 8C 01 2D 11 9A 57 74 9B 57 75 D7 A9 A9 AB AB C3 70 C4 33
  93.            19 05 A9 2E 01 19 03
  94.           )
  95.       2. MACRO-CALL-ERROR CASE #4# #3#
  96.   )  )
  97. #Y(#:TOP-LEVEL-FORM-6 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01) DEFTYPE
  98.    REMOVE-OLD-DEFINITIONS MACRO
  99.    #Y(DEFTYPE
  100.       #207Y(01 00 01 00 00 08 3C 01 A9 6E 41 D5 8C 01 2D 22 9A 57 74 9B 57 57 74 9C 57 57 75 A9 8B
  101.             03 18 A9 D8 37 01 8A 76 07 A9 D9 37 01 8B 76 0D C5 14 AA 5E 01 A9 2E 01 19 03 C2 1A 74
  102.             A7 60 AD 30 60 41 03 8F 01 06 DB 9A 76 5C 01 F7 C7 10 08 C7 10 09 00 10 0A 00 10 0B 00
  103.             10 0C CD 10 0E BD E4 62 19 E5 2C 04 11 E5 6B 12 E8 67 0B 6E 43 BD 67 0C 6E 43 62 19 32
  104.             03 20 78 02 8F 01 11 E9 A9 EA EB EC 62 1E 77 02 03 18 78 03 AA 5C 04 F6 EE EF F0 5F F1
  105.             EC 62 1F 77 02 F2 F3 F4 62 22 6D 4C 6F 02 13 6D CA F5 61 21 B2 77 03 77 03 77 04 61 22
  106.             61 23 EC 62 21 77 02 03 24 78 02 EC 62 1C 77 02 77 03 EC 62 20 77 02 77 05 5C 03 16 02
  107.             12 06 19 09
  108.            )
  109.       3. MACRO-CALL-ERROR "type name should be a symbol, not ~S" TYPE-SYMBOL TYPE-LIST
  110.       "~S is a built-in type and may not be redefined." DECLARE 0. %ARG-COUNT %MIN-ARGS %RESTP
  111.       %LET-LIST %KEYWORD-TESTS '* %DEFAULT-FORM (CDR <DEFTYPE-FORM>) <DEFTYPE-FORM> ANALYZE1
  112.       MAKE-LENGTH-TEST LET* IF ERROR
  113.       "The deftype expander for ~S may not be called with ~S arguments." QUOTE
  114.       ((1- (LENGTH <DEFTYPE-FORM>))) EVAL-WHEN (COMPILE LOAD EVAL) LET %PUT 'DEFTYPE-EXPANDER
  115.       FUNCTION "DEFTYPE-" LAMBDA (<DEFTYPE-FORM>) SETF DOCUMENTATION ('TYPE)
  116.   )  )
  117. #Y(#:TOP-LEVEL-FORM-7 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01) TIME
  118.    REMOVE-OLD-DEFINITIONS MACRO
  119.    #Y(TIME
  120.       #77Y(01 00 01 00 00 08 A9 6E 41 D5 8C 01 2C 3A 9A 57 74 37 01 6E 82 37 01 6E 82 37 01 6E 82
  121.            37 01 6E 82 37 01 6E 82 37 01 6E 82 37 01 6E 82 37 01 6E 82 37 01 6E 82 77 09 D7 A8 D8
  122.            D9 AC DA DB DC A0 78 03 77 03 5C 04 19 05 A9 2E 01 19 03
  123.           )
  124.       2. MACRO-CALL-ERROR MULTIPLE-VALUE-BIND (%%TIME) UNWIND-PROTECT MULTIPLE-VALUE-CALL #'%TIME
  125.       (%%TIME)
  126.   )  )
  127. #Y(#:TOP-LEVEL-FORM-8 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01)
  128.    WITH-INPUT-FROM-STRING REMOVE-OLD-DEFINITIONS MACRO
  129.    #Y(WITH-INPUT-FROM-STRING
  130.       #194Y(01 00 01 00 00 08 3C 01 A9 6E 41 D5 8C 01 2D 80 80 9A 57 56 74 9B 57 56 57 74 9C 57 56
  131.             57 75 A7 D7 67 03 6E 77 A7 0E 03 21 80 6B 02 14 A9 D9 67 03 6E 77 A7 0E 03 21 80 62 02
  132.             14 AB DB 67 03 6E 77 A7 0E 03 21 80 5A 02 14 A3 57 75 AE DC 30 61 A7 5F B4 30 60 41 02
  133.             8F 00 06 DD 99 76 5C 01 F6 DE B3 DF B4 8E 09 80 44 8E 07 80 40 00 78 02 77 02 77 01 A9
  134.             E0 E1 9E 76 8E 0C 3A 00 14 E4 B9 77 02 77 01 32 02 20 78 02 77 01 32 02 20 5D 02 19 0F
  135.             A9 2E 01 19 03 79 00 1A FF 91 C5 F6 00 1A FF 99 79 00 1A FF A2 B0 5C 01 58 1A 41 B1 8E
  136.             08 76 00 58 1A FF B8 E2 B5 E3 BA 77 02 77 03 5C 01 1A FF BA
  137.            )
  138.       2. MACRO-CALL-ERROR :INDEX MACRO-MISSING-VALUE :START 0. :END (:END :START :INDEX) DECLARE
  139.       LET MAKE-STRING-INPUT-STREAM UNWIND-PROTECT PROGN SETF STRING-INPUT-STREAM-INDEX CLOSE
  140.   )  )
  141. #Y(#:TOP-LEVEL-FORM-9 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01) WITH-OPEN-FILE
  142.    REMOVE-OLD-DEFINITIONS MACRO
  143.    #Y(WITH-OPEN-FILE
  144.       #94Y(01 00 01 00 00 08 3C 01 A9 6E 41 D5 8C 01 2D 80 48 9A 57 56 74 9B 57 56 75 9C 57 75 A7
  145.            5F AD 30 60 41 02 8F 00 06 D7 99 76 5C 01 F6 D8 AC D9 9E 76 77 02 77 01 A9 DA DB DC 9F
  146.            76 DD B2 DE B4 77 02 77 03 77 03 DD B1 DE B3 CA 78 02 77 03 77 03 77 01 32 02 20 5D 02
  147.            19 08 A9 2E 01 19 03
  148.           )
  149.       2. MACRO-CALL-ERROR DECLARE LET OPEN UNWIND-PROTECT MULTIPLE-VALUE-PROG1 PROGN WHEN CLOSE
  150.       (:ABORT T)
  151.   )  )
  152. #Y(#:TOP-LEVEL-FORM-10 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01) WITH-OPEN-STREAM
  153.    REMOVE-OLD-DEFINITIONS MACRO
  154.    #Y(WITH-OPEN-STREAM
  155.       #84Y(01 00 01 00 00 08 3C 01 A9 6E 41 D5 8C 01 2D 3F 9A 57 56 74 9B 57 56 57 74 9C 57 75 A7
  156.            5F AD 30 60 41 02 8F 00 06 D7 99 76 5C 01 F6 D8 AC AC 77 02 77 01 A9 D9 DA DB 9F 76 DC
  157.            B2 77 02 77 03 DC B1 C8 78 02 77 03 77 01 32 02 20 5D 02 19 08 A9 2E 01 19 03
  158.           )
  159.       2. MACRO-CALL-ERROR DECLARE LET UNWIND-PROTECT MULTIPLE-VALUE-PROG1 PROGN CLOSE (:ABORT T)
  160.   )  )
  161. #Y(#:TOP-LEVEL-FORM-11 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01)
  162.    WITH-OUTPUT-TO-STRING REMOVE-OLD-DEFINITIONS MACRO
  163.    #Y(WITH-OUTPUT-TO-STRING
  164.       #126Y(01 00 01 00 00 08 3C 01 A9 6E 41 D5 8C 01 2D 80 47 9A 57 56 74 9B 57 56 57 1B 80 41 00
  165.             14 9C 57 56 57 54 54 14 9D 57 75 A7 5F AE 30 60 41 02 8E 00 33 8E 03 39 D8 AD C8 76 77
  166.             01 A9 DA DB AD DE B3 77 02 77 01 32 02 20 76 DC B2 77 02 77 03 77 01 32 02 20 5D 02 19
  167.             09 A9 2E 01 19 03 9B 57 56 57 56 1A FF B8 D7 99 76 5C 01 F6 8F 03 47 D8 AD D9 AE 77 02
  168.             77 02 77 01 A9 DA DB 9E 1A 4A
  169.            )
  170.       2. MACRO-CALL-ERROR DECLARE LET MAKE-STRING-PUSH-STREAM UNWIND-PROTECT PROGN CLOSE
  171.       ((MAKE-STRING-OUTPUT-STREAM)) GET-OUTPUT-STREAM-STRING
  172.   )  )
  173. #Y(#:TOP-LEVEL-FORM-12 #13Y(00 00 00 00 00 01 D5 37 02 30 DE 19 01) "LISP")
  174. #Y(#:TOP-LEVEL-FORM-13 #13Y(00 00 00 00 00 01 D5 37 01 30 D6 19 01) WITH-OUTPUT-TO-PRINTER)
  175. #Y(#:TOP-LEVEL-FORM-14 #13Y(00 00 00 00 00 01 D5 37 02 30 DE 19 01) "SYSTEM")
  176. #Y(#:TOP-LEVEL-FORM-15 #18Y(00 00 00 00 00 01 D5 2E 01 D5 D7 C3 76 31 74 C0 19 01)
  177.    WITH-OUTPUT-TO-PRINTER REMOVE-OLD-DEFINITIONS MACRO
  178.    #Y(WITH-OUTPUT-TO-PRINTER
  179.       #70Y(01 00 01 00 00 08 3C 01 A9 6E 41 D5 8C 01 2D 31 9A 57 56 74 9B 57 75 A7 5F AC 30 60 41
  180.            02 8F 00 06 D7 99 76 5C 01 F6 D8 AB C4 76 77 01 A9 DA DB 9E 76 DC B0 77 02 77 03 77 01
  181.            32 02 20 5D 02 19 07 A9 2E 01 19 03
  182.           )
  183.       2. MACRO-CALL-ERROR DECLARE LET ((MAKE-PRINTER-STREAM)) UNWIND-PROTECT PROGN CLOSE
  184.   )  )